home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / AlphaLite.6.52 / Tcl / SystemCode / appleEvents.tcl < prev    next >
Text File  |  1997-03-29  |  8KB  |  281 lines
  1.  
  2. # make alias list to pass to AEBuild
  3. proc makeAlis {name} {
  4.     return "\[alis(«[coerce TEXT $name -x alis]»)\]"    
  5. }
  6.  
  7. proc makeFile {name} {
  8.     return "alis(«[coerce TEXT $name -x alis]»)"    
  9. }
  10.  
  11. proc makeAlises {args} {
  12.     set str "\["
  13.     set sep ""
  14.     foreach name $args {
  15.         append str "${sep}alis(«[coerce TEXT $name -x alis]»)"
  16.         set sep ","
  17.     }
  18.     append str "\]"
  19.     return $str
  20. }
  21.  
  22. # Queued replies are passed through AEPrint and then to this routine.
  23. if {![llength [info command handleReply]]} {
  24.     proc handleReply {rep} {
  25.         global ALPHA lastReply
  26.     #    switchTo $ALPHA
  27.         set lastReply $rep
  28.     }
  29. }
  30.  
  31.  
  32. # Return an object record specifying the desired think project file.
  33. proc fileObject {name} {
  34.     join [concat {obj\{want:type('SFIL'), from:'null'(), form:'name', seld:“} [file tail $name] {”\}}] ""
  35. }
  36.  
  37. proc sendOpenEvent {filler appname fname} {
  38.     if {$filler == "noReply"} {
  39.         AEBuild $appname aevt odoc "----" [makeAlis $fname]
  40.     } else {
  41.         AEBuild -r $appname aevt odoc "----" [makeAlis $fname]
  42.     }
  43. }
  44.  
  45.  
  46. # Send open folder event to Finder. Name must end in colon.
  47. proc openFolder {name} {
  48.     if {![regexp ".*:$" $name]} {
  49.         append name ":"
  50.     }
  51.     sendOpenEvent -r Finder $name
  52. }
  53.  
  54. proc launchDoc {name} {
  55.     set app [launchForeAppl [getFileSig $name]]
  56.     sendOpenEvent -r [file tail $app] $name
  57. }
  58.  
  59.  
  60. # Called from Alpha when titlebar "title" menu selected (command-mouse).
  61. proc getTitleBarPath {} {
  62.     global fetched
  63.     
  64.     set f [car [winNames -f]]
  65.     if {[info exists fetched($f)]} {
  66.         set nm "[car $fetched($f)]/[cadr $fetched($f)]/[file tail $f]"
  67.         regsub -all {//} $nm {/} nm
  68.         regsub -all {/} $nm {:} nm
  69.         return $nm
  70.     } else {
  71.         return $f
  72.     }
  73. }
  74.  
  75.  
  76. proc titlebar {name} {
  77.     global fetched
  78.     
  79.     if {[info exists fetched([car [winNames -f]])]} {
  80.         set specs $fetched([car [winNames -f]])
  81.         regexp {[^:]*:(.*)} $name dummy dir
  82.         if {[regexp {:} $dir]} {
  83.             regexp {(.*):([^:]*)} $dir dummy dir fname
  84.         } else {
  85.             set fname ""
  86.         }
  87.         regsub -all {:} $dir {/} dir
  88.         ftpBrowse [car $specs] $dir [caddr $specs]  [cadddr $specs] $fname
  89.     } else {
  90.         findFile $name
  91.     }
  92. }
  93.  
  94.  
  95. # Send multiple open events
  96. proc sendOpenEvents {appname args} {
  97.     AEBuild -r $appname aevt odoc "----" [eval makeAlises $args]
  98. }
  99.  
  100. proc openAndSendFile {sig} {
  101.     set fname [car [winNames -f]]
  102.     if {[winDirty]} {
  103.         if {[askyesno "Save '$fname'?"] == "yes"} {
  104.             save
  105.         }
  106.     }
  107.  
  108.     set name [file tail [launchForeAppl $sig]]
  109.     sendOpenEvent noReply $name $fname
  110. }
  111.  
  112. #================================================================================
  113. # General Apple Event handling routines
  114. #
  115. # (written by Tom Pollard for use in the MacPerl package)
  116. #================================================================================
  117.  
  118. # Quit an application.
  119. proc sendQuitEvent {appname} {
  120.     AEBuild $appname "aevt" "quit" 
  121. }
  122.  
  123. # Close one of an application's windows, designated by number.
  124. proc sendCloseWinNum {appname num} {
  125.     AEBuild $appname "core" "clos" "----" [AEWinByPos $num]
  126. }
  127.  
  128. # Close one of an application's windows, designated by name.
  129. proc sendCloseWinName {appname name} {
  130.     AEBuild $appname "core" "clos" "----" [AEWinByName $name]
  131. }
  132.  
  133. # Obtain the number of lines in one of an application's
  134. # windows, designated by name.
  135. proc sendCountLines {appname name} {
  136.     set winObj [AEWinByName $name]
  137.     set res [AEBuild -r $appname "core" "cnte" "----" $winObj kocl type('clin')]    
  138.     if {[regexp {:(.*)\}} $res allofit nlines]} {
  139.         return $nlines
  140.     } else {
  141.         return 0
  142.     }
  143. }
  144.  
  145. # Get a selected range of lines from one of an application's
  146. # windows, designated by name.  If $last is missing, then a single
  147. # line is returned; if both $first and $last are missing, then
  148. # the complete window contents are returned.
  149. proc sendGetText {appname name {first {missing}} {last {missing}}} {
  150.     global ALPHA
  151.     set winObj [AEWinByName $name]
  152.     if {$first != "missing"} {
  153.         if {$last != "missing"} {
  154.             set rangDesc [AELineRange $first $last]
  155.         } else {
  156.             set rangDesc [AEAbsPos $first]
  157.         }
  158.         set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
  159.     } else {
  160.         set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
  161.     }
  162.     set res [AEBuild -r $appname "core" "getd" "----" $objDesc]    
  163.     if {![regexp {“.*”} $res text]} { set text {} }
  164.     return [string trim $text {“”}]
  165. }
  166.  
  167. # Set a selected range of lines in one of an application's
  168. # windows, designated by name.  If $last is missing, then a single
  169. # line is changed; if both $first and $last are missing, then
  170. # the complete window contents are replaced by the new text.
  171. proc sendSetText {appname name text {first {missing}} {last {missing}}} {
  172.     set winObj [AEWinByName $name]
  173.     if {$first != "missing"} {
  174.         if {$last != "missing"} {
  175.             set rangDesc [AELineRange $first $last]
  176.         } else {
  177.             set rangDesc [AEAbsPos $first]
  178.         }
  179.         set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
  180.     } else {
  181.         set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
  182.     }
  183.     set res [AEBuild -r $appname "core" "setd" "----" $objDesc "data" [curlyq $text]]    
  184.     if {![regexp {“.*”} $res text]} { set text {} }
  185.     return [string trim $text {“”}]
  186. }
  187.  
  188. ################################################################################
  189. # Utility functions for constructing AppleEvent descriptors for AEBuild
  190. ################################################################################
  191.  
  192. proc AEFilename {name} {
  193.     return "obj{want:type('file'), from:'null'(), [AEName $name] } "
  194. }
  195.  
  196. proc AEWinByName {name} {
  197.     return "obj{want:type('cwin'), from:'null'(), [AEName $name] } "
  198. }
  199.  
  200. proc AEWinByPos {absPos} {
  201.     return "obj{want:type('cwin'), from:'null'(), [AEAbsPos $absPos] } "
  202. }
  203.  
  204. proc AELineRange {absPos1 absPos2} {
  205.     set lineObj1 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos1] }"
  206.     set lineObj2 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos2] }"
  207.     return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2 } "
  208. }
  209.  
  210. proc AEAbsPos {posName} {
  211. #
  212. # Use '1' or 'first' to specify first position
  213. # and '-1' or 'last' to specify last position.
  214. #
  215.     if {$posName == "first"} { 
  216.         set posName 1 
  217.     } elseif {$posName == "last"} { 
  218.         set posName -1 
  219.     }
  220.     if {$posName >= -1} {
  221.         return "form:indx, seld:long($posName)"
  222.     } else {
  223.         error "AEAbsPos: bad argument"
  224.     }
  225. }
  226.  
  227. proc AEName {name} {
  228.     return "form:'name', seld:[curlyq $name]"
  229. }
  230.  
  231. proc curlyq {str} {
  232.     regsub -all {([“”])} $str {"} newstr
  233.     return "\“$newstr\”"
  234. }
  235.  
  236. ################################################################################
  237. proc nullObject {}                     { return "'null'()" }
  238. proc objectType {type}                 { return "type($type)" }
  239. proc nameObject {type name from}     { return "obj \{form:name, want:[objectType $type], seld:$name, from:$from\}" }
  240. proc indexObject {type ind from}     { return "obj \{form:indx, want:[objectType $type], seld:$ind, from:$from\}" }
  241. proc propertyObject { prop object } { return "obj \{form:prop, want:[objectType prop], seld:[objectType $prop], from:$object\}" }
  242.  
  243. # 'process' must have single quotes
  244. proc buildMsgReply { process suite event args } { return [eval [list AEBuild -r $process $suite $event ] $args] }
  245.  
  246. proc countObjects { process fromObject class } {
  247.     set res [AEBuild -r $process core cnte ---- $fromObject kocl [objectType $class]]
  248.     if {[regexp {:([0-9]+)} $res dummy mtch]} {
  249.         return $mtch
  250.     } else {
  251.         error "Bad count proc"
  252.     }
  253. }
  254.  
  255. proc createThingAtEnd {process container class} {
  256.     set res [AEBuild -r $process core crel insh "insl \{kobj:$container\}" kocl "type($class)"]
  257. }
  258.  
  259.  
  260. proc getObjectData { process class name from } {
  261.     set res [AEBuild -r $process core getd ---- [nameObject $class "“$name”" $from] {rtyp{type:TEXT}}]
  262.     if {[regexp {“(.*)”} $res dummy mtch]} {
  263.         return $mtch
  264.     } else {
  265.         error "Bad count proc"
  266.     }
  267. }
  268.  
  269.  
  270. proc objectProperty { process property object } {
  271.     AEBuild -r $process core getd ---- [propertyObject $property $object]
  272. }
  273.  
  274. # Extract and return a path from a result.
  275. proc extractPath {res} {
  276.     if {[regexp {«(.*)»} $res dummy fss]} {
  277.         return [specToPathName $fss]
  278.     }
  279.     error "bad path $name"
  280. }    
  281.